HPAVC/HPAVC CD-ROM.iso/pc/TUGU10.ZIP/FRACTAL.PAS

Pascal/Delphi Source File | 1995-04-04 | 15.9 KB | 616 lines

{$N+,E+}

Program FractalExplorer;

Uses tugu,jmouse,crt;

Label Beginning;

Const
  mandtype = 2; { what power? }


Type
  unreal = extended;

Var
  ftype : integer;
  paltype : integer;
  stdpal : palarray;
  itterations : integer;
  achar : char;

  xorg,yorg,xlim,ylim,
  newxo,newyo,newxl,newyl : unreal;
  xstart,ystart : unreal;           { used for julia set }

  mousexo,mouseyo,mousexl,mouseyl,
  oldmxl,oldmyl,oldmxo,oldmyo : word;
  tempxo,tempyo : word;

  i,j : integer;
  a,b : word;
  temp : byte;
  stuff : string;
  font : pointer;
  waitfor0,waitfor1 : boolean;
  rec : array [1..4,0..319] of byte;

  backcolor : byte;              { mouse variables }
  curwidth, curheight : word;
 { cursorptr,}lcursor : pointer;
  buttons : byte;

  zoomout : array [0..10] of record
              order : byte; { indicates # of zooms back }
              ptr : pointer; { points to screen shot of picture }
              x1,x2,y1,y2 : unreal; { coords for zoom window }
            End;
  zn : byte;  { indicates which zoom is being used }
  maxzooms : integer;

  redrawfractal : boolean;
  palnum : integer;
  colnum : integer;
  firstfractal : boolean;
  pickjuliapoint : boolean;
  fv : file;

Procedure SquareComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
                                                 { in graph }
Var
                           { (x + yi)^2 = x^2 - y^2 + 2xyi }
temp : unreal;

Begin
  temp := x*x - y*y + xp;
  y := 2 * x * y + yp;
  x := temp;
End;

Procedure ThirdComplex(Var x,y,xp,yp : unreal);

Var

temp : unreal;

Begin
  temp := x*x*x - 3*y*y*x + xp;
  y := -y*y*y + 3*x*x*y + yp;
  x := temp;
End;

Procedure ForthComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
                                                { on graph }
Var
                           { (x + yi)^4 = x^4 + y^4 - 6(x^2)(y^2) + }
temp : unreal;             {              4(x^3)(y)i - 4(x)(y^3)i }

Begin
  temp := x*x*x*x + y*y*y*y - 6*x*x*y*y + xp;
  y := 4*x*x*x*y - 4*x*y*y*y + yp;
  x := temp;
End;

Procedure FifthComplex(Var x,y,xp,yp : unreal);

Var

temp : unreal;

Begin
  temp := x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + xp;
  y := 5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y + yp;
  x := temp;
End;

Procedure SixthComplex(Var x,y,xp,yp : unreal);

Var
  temp : unreal;

Begin
  temp := (x*x*x*x*x*x) + (15*x*x*y*y*y*y) - (15*x*x*x*x*y*y) - (y*y*y*y*y*y) + xp;
  y := (6*x*y*y*y*y*y) - (20*x*x*x*y*y*y) + (6*x*x*x*x*x*y) + yp;
  x := temp;
End;

Procedure SeventhComplex(Var x,y,xp,yp : unreal);

Var

temp : unreal;

Begin
  temp := x*x*x*x*x*x*x - 21*x*x*x*x*x*y*y + 35*x*x*x*y*y*y*y - 7*x*y*y*y*y*y*y + xp;
  y := 7*x*x*x*x*x*x*y - 35*x*x*x*x*y*y*y + 21*x*x*y*y*y*y*y - y*y*y*y*y*y*y + yp;
  x := temp;
End;

Procedure EighthComplex(Var x,y,xp,yp : unreal);

Var
  temp : unreal;

Begin
  temp := (x*x*x*x*x*x*x*x) - (28*x*x*x*x*x*x*y*y);
  temp := temp + (70*x*x*x*x*y*y*y*y) - (28*y*y*y*y*y*y*x*x) + (y*y*y*y*y*y*y*y) + xp;
  y := (8*x*x*x*x*x*x*x*y) - (56*x*x*x*x*x*y*y*y) + (56*x*x*x*y*y*y*y*y) - (8*x*y*y*y*y*y*y*y) + yp;
  x := temp;
End;

Procedure DisplayMandelbrot(xorg,yorg,xlim,ylim : unreal; maxittr : word; ftype : integer);

Var
  xstep,ystep : unreal; { distance between pixels }
  xpos,ypos : unreal;   { current pixel evaluation position }
  done : boolean;
  steps : word;
  xiter,yiter : unreal; { itterated values of x,y }
  temp : unreal;

Begin
  xstep := (xlim-xorg)/320;
  ystep := (ylim-yorg)/200;
  ypos := yorg;
  for i := 0 to ymax do
  Begin
    xpos := xorg;
    for j := 0 to xmax do
    Begin
      color := 1;
      putpix(j,i);
      xiter := 0;
      yiter := 0;
      steps := 0;
      done := false;
      if ftype = 2 then
      Begin
        xiter := xpos;
        yiter := ypos;
      End;
      Repeat
        steps := steps + 1;
        if ftype = 1 then
        Begin
          xstart := xpos;
          ystart := ypos;
        End;
        Case mandtype of
          2 : SquareComplex(xiter,yiter,xstart,ystart);
          3 : ThirdComplex(xiter,yiter,xstart,ystart);
          4 : ForthComplex(xiter,yiter,xstart,ystart);
          5 : FifthComplex(xiter,yiter,xstart,ystart);
          6 : SixthComplex(xiter,yiter,xstart,ystart);
          7 : SeventhComplex(xiter,yiter,xstart,ystart);
          8 : EighthComplex(xiter,yiter,xstart,ystart);
        End;
        if sqr(xiter)+sqr(yiter) >= 9 then done := true;

        if steps > maxittr then done := true;
      Until done;
      steps := steps - 1;
      color := steps mod 196;
      if color = 0 then color := 196;
      if steps < maxittr then putpix(j,i);
      if steps >= maxittr then
      Begin
        color := 0;
        putpix(j,i);
      End;

      xpos := xpos + xstep;
    End;
    ypos := ypos + ystep;
  End;
End;



Procedure TwoColor(num,num2 : integer);

Var
  bright,bright2 : integer;

Begin
  num := num mod 12;
  num2 := num2 mod 12;
  if num < 6 then bright := 47 else bright := 63;
  if num2 < 6 then bright2 := 47 else bright2 := 63;

  num := num mod 6;
  num2 := num2 mod 6;
  pal[1,1] := bright*abs(((num-3) div 2));
  pal[1,2] := bright*abs(abs(((num-2) div 2))-1);
  pal[1,3] := bright*(num div 3);

  pal[98,1] := bright2*abs(((num2-3) div 2));
  pal[98,2] := bright2*abs(abs(((num2-2) div 2))-1);
  pal[98,3] := bright2*(num2 div 3);

  pal[196,1] := bright*abs(((num-3) div 2));
  pal[196,2] := bright*abs(abs(((num-2) div 2))-1);
  pal[196,3] := bright*(num div 3);

  smoothblend(pal,1,98);
  smoothblend(pal,98,196);

  setrgbpal(pal);
End;



Procedure DarkRainbow(num : byte);

Begin
  pal[1,(num mod 3)+1] := 63;
  pal[1,((num+1) mod 3)+1] := 0;
  pal[1,((num+2) mod 3)+1] := 0;

  pal[64,(num mod 3)+1] := 0;
  pal[64,((num+1) mod 3)+1] := 63;
  pal[64,((num+2) mod 3)+1] := 0;

  pal[128,(num mod 3)+1] := 0;
  pal[128,((num+1) mod 3)+1] := 0;
  pal[128,((num+2) mod 3)+1] := 63;

  pal[196,(num mod 3)+1] := 63;
  pal[196,((num+1) mod 3)+1] := 0;
  pal[196,((num+2) mod 3)+1] := 0;

  smoothblend(pal,1,64);
  smoothblend(pal,64,128);
  smoothblend(pal,128,196);

  setrgbpal(pal);
End;


Procedure StandardPal;

Begin
  SetRGBPal(stdpal);
End;



Begin
  ChgMouseColor(cursorptr,197);
  lcursor := NIL;
  randomize;
  paltype := 2;
  writeln('# of itterations (0-1024) (386dx try 128, 486dx try 256)');
  readln(itterations);
  if keypressed then achar := readkey;

  vgamode;
  GetRGBPal(pal);
  for i := 1 to 3 do
  Begin
    pal[0,i] := 0;
    pal[197,i] := 63;
    pal[213,i] := 0;
  End;
  smoothblend(pal,197,213);
  stdpal := pal;
  SetRGBPal(pal);

  palnum := 0;

  loadfont(font,'fractal.tf');
  if paltype = 2 then { rainbow palette }
    darkrainbow(1);
  xorg := -1.6295234671;
  xlim := -1.6295234666;
  yorg := -0.0051268052382;
  ylim := -0.0051268047045;

  xorg := -0.74401626712;
  xlim := -0.74401604109;
  yorg := 0.14716055214;
  ylim := 0.14716077093;

  i := 0;
  Repeat
    getmem(zoomout[i].ptr,64000);
    i := i + 1;
  Until memavail < 70000;
  maxzooms := i - 1;

beginning:
  ftype := 1;

  xorg := -2.2;
  xlim := 2.2;
  yorg := -1.5;
  ylim := 1.5;

  xstart := 0.4;
  ystart :=-0.35;
  clrbuf(0);

  for i := 0 to maxzooms do
    zoomout[i].order := maxzooms + 1; { indicates unused }
  zoomout[0].order := 0;
  zn := 0;
  zoomout[0].x1 := xorg;
  zoomout[0].x2 := xlim;
  zoomout[0].y1 := yorg;
  zoomout[0].y2 := ylim;

  redrawfractal := true;

  colnum := random(12);
  assign(fv,'mandel.pcx');
  {$I-}
  reset(fv);
  {$I+}
  if (mandtype = 2) and (ioresult = 0) then
    PCXLoad('mandel.pcx',pal,0,0)
  else
    DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);

  firstfractal := true;

  pickjuliapoint := false;

  achar := #0;
  Repeat
    if not(firstfractal) then begin
      if redrawfractal then DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype)
      else
        BuftoScreen(zoomout[zn].ptr);
    End;
    firstfractal := false;

    if pickjuliapoint then begin
      Repeat
        MouseStatus(i,j,buttons);
      Until buttons mod 2 = 0;
      repeat
        MoveMouseA(cursorptr,buttons,0,lcursor);
        MoveMouseb(cursorptr,buttons,0,lcursor);
      Until buttons = 1;
      xstart := (mousex/SW)*(zoomout[zn].x2-zoomout[zn].x1) + zoomout[zn].x1;
      ystart := (mousey/SH)*(zoomout[zn].y2-zoomout[zn].y1) + zoomout[zn].y1;
      firstfractal := false;
      ftype := 2;
      pickjuliapoint := false;
      xorg := -2.2;
      xlim := 2.2;
      yorg := -1.5;
      ylim := 1.5;
      zoomout[0].x1 := xorg;
      zoomout[0].x2 := xlim;
      zoomout[0].y1 := yorg;
      zoomout[0].y2 := ylim;
      for i := 0 to maxzooms do begin
        zoomout[i].order := maxzooms + 1; { indicates unused }
      End;
      zoomout[0].order := 0;
      zn := 0;
      DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);
      resetmouse(cursorptr,lcursor);
    End;

    newxo := xorg;
    newxl := xlim;
    newyo := yorg;
    newyl := ylim;

    ScreentoBuf(zoomout[zn].ptr);

    mousexo := 10000;
    mousexl := 10000;
    Repeat
      backcolor := 0;
      curwidth := 5;
      curheight := 10;

      MovemouseA(cursorptr,buttons,0,lcursor);  { first movemouse }

      if (waitfor1) and (buttons = 1) then      { image processing & stuff }
      Begin                                     { | | | | | | | | | | | |  }
        waitfor0 := true;                       { V V V V V V V V V V V V  }
        waitfor1 := false;
        newxo := xorg + (xlim-xorg)/320*mousex;
        newyo := yorg + (ylim-yorg)/200*mousey;
        oldmxo := mousexo;
        oldmyo := mouseyo;
        mousexo := mousex;
        mouseyo := mousey;
      End;
      if (waitfor0) and (buttons = 0) then
      Begin
        waitfor0 := false;
        waitfor1 := true;
        newxl := xorg + (xlim-xorg)/320*mousex;
        newyl := yorg + (ylim-yorg)/200*mousey;
      End;

      if (waitfor0) and (buttons = 1) and ((mousecx <> 0) or (mousecy <> 0)) then
      Begin
        if mousex <= mousexo then mousex := mousexo;
        if mousey <= mouseyo then mousey := mouseyo;
        oldmxl := mousexl;
        oldmyl := mouseyl;
        mousexl := mousex;
        mouseyl := mousey;
        if oldmxl <> 10000 then
        Begin
          if oldmxo <> 10000 then begin
            tempxo := oldmxo;
            tempyo := oldmyo;
          End
          else begin
            tempxo := mousexo;
            tempyo := mouseyo;
          End;
          for i := tempyo to oldmyl do begin
            color := rec[1,i];
            putpix(tempxo,i);
          End;
          for i := tempxo+1 to oldmxl-1 do begin
            color := rec[2,i];
            putpix(i,tempyo);
          End;
          if oldmyl > tempyo then
            for i := tempyo to oldmyl do begin
              color := rec[3,i];
              putpix(oldmxl,i);
            End;
          if oldmxl > tempxo+2 then
            for i := tempxo+1 to oldmxl-1 do begin
              color := rec[4,i];
              putpix(i,oldmyl);
            End;
        End;
        oldmxo := mousexo;
        oldmyo := mouseyo;
        for i := mouseyo to mouseyl do
          rec[1,i] := getpix(mousexo,i);
        for i := mousexo+1 to mousexl-1 do
          rec[2,i] := getpix(i,mouseyo);
        if mouseyl > mouseyo then
          for i := mouseyo to mouseyl do
            rec[3,i] := getpix(mousexl,i);
        if mousexl > mousexo+2 then
          for i := mousexo+1 to mousexl-1 do
            rec[4,i] := getpix(i,mouseyl);
        color := 197;
      End;
      color := 197;
      if (mousecx <> 0) or (mousecy <> 0) then
      Begin
        getimage(mousex,mousey,mousex+curwidth-1,mousey+curheight-1,lcursor);
        if (waitfor0) and (buttons = 1) then
          rectangle(mousexo,mouseyo,mousexl,mouseyl);
      End;

      MoveMouseB(cursorptr,buttons,0,lcursor);  { Second Movemouse }
                                                { Easy isn't it! :) }
      if keypressed then achar := readkey;
    Until ((buttons = 2) or (ord(achar) = 27));
    putimage(mousex,mousey,lcursor);
    resetmouse(cursorptr,lcursor);    { moved out a mouse loop, have to reset! }

    color := 203;
    rectanglefill(0,0,78,17);
    rectanglefill(79,0,148,17);
    rectanglefill(149,0,217,17);
    rectanglefill(218,0,287,17);
    rectanglefill(0,18,78,34);
    rectanglefill(79,18,148,34);

    color := 205;
    rectanglefill(1,1,77,16);
    rectanglefill(80,1,147,16);
    rectanglefill(150,1,216,16);
    rectanglefill(219,1,286,16);
    rectanglefill(1,19,77,33);
    rectanglefill(80,19,147,33);

    color := 197;
    stuff := 'ZOOM OUT';
    curbuf := vidptr;
    textxy(font,stuff,4,4,1);
    stuff := 'ZOOM IN';
    textxy(font,stuff,83,4,1);
    stuff := 'RESTART';
    textxy(font,stuff,153,4,1);
    stuff := 'PAL CHG';
    textxy(font,stuff,222,4,1);
    stuff := 'PCX SAVE';
    textxy(font,stuff,4,21,1);
    stuff := 'JULIA';
    textxy(font,stuff,92,21,1);
    Repeat
      MovemouseA(cursorptr,buttons,0,lcursor);
      MovemouseB(cursorptr,buttons,0,lcursor);
      if keypressed then achar := readkey;
    Until ((buttons = 1) or (ord(achar) = 27));
    resetmouse(cursorptr,lcursor);
    redrawfractal := false;
    if ((mousey < 17) and (buttons = 1)) then begin
      if mousex < 79 then begin           { ZOOM OUT }
        temp := zn;
        zn := maxzooms + 1;
        for i := 0 to maxzooms do
          if zoomout[i].order = 1 then zn := i;
        if zn < (maxzooms+1) then
        Begin
          xorg := zoomout[zn].x1;
          xlim := zoomout[zn].x2;
          yorg := zoomout[zn].y1;
          ylim := zoomout[zn].y2;
          for i := 0 to maxzooms do
          Begin
            if zoomout[i].order <= maxzooms then
              zoomout[i].order := zoomout[i].order - 1
            else
              zoomout[i].order := maxzooms + 1;
            if zoomout[i].order = 0 then zn := i;
          End;
        End
        else zn := temp;
      End
      else
      if (mousex < 149) then              { ZOOM IN }
      Begin
        xorg := newxo;
        yorg := newyo;
        xlim := newxl;
        ylim := newyl;
        zn := 0;
        While zoomout[zn].order < maxzooms do
          zn := zn + 1;
        for i := 0 to maxzooms do
          zoomout[i].order := zoomout[i].order + 1;
        zoomout[zn].order := 0;
        zoomout[zn].x1 := xorg;
        zoomout[zn].x2 := xlim;
        zoomout[zn].y1 := yorg;
        zoomout[zn].y2 := ylim;
        redrawfractal := true;
      End
      else
      if mousex < 218 then goto beginning  { RESTART }
      else
      if mousex < 288 then begin            { CHANGE PAL }
        Repeat
          i := random(12);
        Until i <> colnum;
        if palnum < 4 then
          Twocolor(colnum,i);
        if palnum = 5 then
          DarkRainbow(colnum mod 3);
        if palnum = 4 then
          StandardPal;
        if (palnum > 5) and (palnum < 10) then
          TwoColor(colnum,i);
        if palnum = 10 then
          DarkRainbow(colnum mod 3);
        if palnum < 10 then
          palnum := palnum + 1
        else
          palnum := 0;
        colnum := (colnum + 1) mod 12;
        redrawfractal := false;
      End;
    End   { mousey < 17 }
    else if ((mousey < 33) and (buttons = 1)) then begin
      if mousex < 79 then begin                          { PCX SAVE }
        curbuf := zoomout[zn].ptr;
        PCXSave('fractal.pcx',pal,0,0,319,199);
        curbuf := vidptr;
      End
      else if mousex < 149 then begin                    { JULIA }
        if ftype = 1 then pickjuliapoint := true;
      End;
    End;  { mousey < 33 }
  if keypressed then achar := readkey;
  Until ord(achar) = 27;
  setmode(3);
End.